home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Visual Basic new SourceCode and Projects / Adventure game / mdinote.bas < prev    next >
Encoding:
BASIC Source File  |  1999-05-12  |  4.0 KB  |  140 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. Type FormState
  4. Deleted As Integer
  5. Dirty As Integer
  6. Color As Long
  7. End Type
  8. Public FState()  As FormState
  9. Public Document() As New frmNotePad
  10. Public gFindString As String
  11. Public gFindCase As Integer
  12. Public gFindDirection As Integer
  13. Public gCurPos As Integer
  14. Public gFirstTime As Integer
  15. Public gToolsHidden As Boolean
  16. Public Const ThisApp = "AGC"
  17. Public Const ThisKey = "Recent Files"
  18. Function AnyPadsLeft() As Integer
  19. End Function
  20. Sub EditCopyProc()
  21. Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
  22. End Sub
  23. Sub EditCutProc()
  24. Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
  25. frmMDI.ActiveForm.ActiveControl.SelText = ""
  26. End Sub
  27. Sub EditPasteProc()
  28. frmMDI.ActiveForm.ActiveControl.SelText = Clipboard.GetText()
  29. End Sub
  30. Sub FileNew()
  31. Dim fIndex As Integer
  32. fIndex = FindFreeIndex()
  33. Document(fIndex).Tag = fIndex
  34. Document(fIndex).Caption = "Untitled:" & fIndex
  35. Document(fIndex).Show
  36. frmMDI.imgCutButton.Visible = True
  37. frmMDI.imgCopyButton.Visible = True
  38. frmMDI.imgPasteButton.Visible = True
  39. End Sub
  40. Function FindFreeIndex() As Integer
  41. Dim i As Integer
  42. Dim ArrayCount As Integer
  43. ArrayCount = UBound(Document)
  44. For i = 1 To ArrayCount
  45. If FState(i).Deleted Then
  46. FindFreeIndex = i
  47. FState(i).Deleted = False
  48. Exit Function
  49. End If
  50. Next
  51. ReDim Preserve Document(ArrayCount + 1)
  52. ReDim Preserve FState(ArrayCount + 1)
  53. FindFreeIndex = UBound(Document)
  54. End Function
  55. Sub FindIt()
  56. Dim intStart As Integer
  57. Dim intPos As Integer
  58. Dim strFindString As String
  59. Dim strSourceString As String
  60. Dim strMsg As String
  61. Dim intResponse As Integer
  62. Dim intOffset As Integer
  63. If (gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart) Then
  64. intOffset = 1
  65. Else
  66. intOffset = 0
  67. End If
  68. If gFirstTime Then intOffset = 0
  69. intStart = frmMDI.ActiveForm.ActiveControl.SelStart + intOffset
  70. If gFindCase Then
  71. strFindString = gFindString
  72. strSourceString = frmMDI.ActiveForm.ActiveControl.Text
  73. Else
  74. strFindString = UCase(gFindString)
  75. strSourceString = UCase(frmMDI.ActiveForm.ActiveControl.Text)
  76. End If
  77. If gFindDirection = 1 Then
  78. intPos = InStr(intStart + 1, strSourceString, strFindString)
  79. Else
  80. For intPos = intStart - 1 To 0 Step -1
  81. If intPos = 0 Then Exit For
  82. If Mid(strSourceString, intPos, Len(strFindString)) = strFindString Then Exit For
  83. Next
  84. End If
  85. If intPos Then
  86. frmMDI.ActiveForm.ActiveControl.SelStart = intPos - 1
  87. frmMDI.ActiveForm.ActiveControl.SelLength = Len(strFindString)
  88. Else
  89. strMsg = "Cannot find " & Chr(34) & gFindString & Chr(34)
  90. intResponse = MsgBox(strMsg, 0, App.Title)
  91. End If
  92. gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart
  93. gFirstTime = False
  94. End Sub
  95. Sub GetRecentFiles()
  96. Dim i, j As Integer
  97. Dim varFiles As Variant
  98. If GetSetting(ThisApp, ThisKey, "RecentFile1") = Empty Then Exit Sub
  99. varFiles = GetAllSettings(ThisApp, ThisKey)
  100. For i = 0 To UBound(varFiles, 1)
  101. frmMDI.mnuRecentFile(0).Visible = True
  102. frmMDI.mnuRecentFile(i).Caption = varFiles(i, 1)
  103. frmMDI.mnuRecentFile(i).Visible = True
  104. For j = 1 To UBound(Document)
  105. If Not FState(j).Deleted Then
  106. Document(j).mnuRecentFile(0).Visible = True
  107. Document(j).mnuRecentFile(i + 1).Caption = varFiles(i, 1)
  108. Document(j).mnuRecentFile(i + 1).Visible = True
  109. End If
  110. Next j
  111. Next i
  112. End Sub
  113. Sub OptionsToolbarProc(CurrentForm As Form)
  114. CurrentForm.mnuOptionsToolbar.Checked = Not CurrentForm.mnuOptionsToolbar.Checked
  115. If Not TypeOf CurrentForm Is MDIForm Then
  116. frmMDI.mnuOptionsToolbar.Checked = CurrentForm.mnuOptionsToolbar.Checked
  117. End If
  118. If CurrentForm.mnuOptionsToolbar.Checked Then
  119. frmMDI.picToolbar.Visible = True
  120. frmMDI.CoolBar1.Visible = True
  121. Else
  122. frmMDI.picToolbar.Visible = False
  123. frmMDI.CoolBar1.Visible = False
  124. End If
  125. End Sub
  126. Sub WriteRecentFiles(OpenFileName)
  127. Dim i, j As Integer
  128. Dim strFile, key As String
  129. For i = 3 To 1 Step -1
  130. key = "RecentFile" & i
  131. strFile = GetSetting(ThisApp, ThisKey, key)
  132. If strFile <> "" Then
  133. key = "RecentFile" & (i + 1)
  134. SaveSetting ThisApp, ThisKey, key, strFile
  135. End If
  136. Next i
  137. SaveSetting ThisApp, ThisKey, "RecentFile1", OpenFileName
  138. End Sub
  139.  
  140.